home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / errortbl / errortbl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  14.6 KB  |  394 lines
  1. unit Errortbl;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DB, DBTables, DBITypes, DBIProcs, DBIErrs;
  8.  
  9. type
  10.   TErrorTable = class(TTable)
  11.   private
  12.     FPrevOnException: TExceptionEvent;
  13.     FOnKeyViolation: TExceptionEvent;
  14.     FOnMinCheckFail: TExceptionEvent;
  15.     FOnMaxCheckFail: TExceptionEvent;
  16.     FOnFldRequired: TExceptionEvent;
  17.     FOnMasterMissing: TExceptionEvent;
  18.     FOnLookupTblFail: TExceptionEvent;
  19.     FOnRecLockFail: TExceptionEvent;
  20.     FOnRecUnLockFail: TExceptionEvent;
  21.     FOnFileIsLocked: TExceptionEvent;
  22.     FOnDirIsLocked: TExceptionEvent;
  23.      FOnMultipleNetFiles: TExceptionEvent;
  24.     FOnOtherErrors: TExceptionEvent;
  25.     FErrorToken: string;
  26.     FErrorTableName: string;
  27.     FErrorFieldName: string;
  28.     FErrorFieldDispName: string;
  29.     FErrorFieldMinValue: string;
  30.     FErrorFieldMaxValue: string;
  31.     FErrorLookupTableName: string;
  32.     FErrorImageRow: string;
  33.     FErrorUserName: string;
  34.     FErrorFileName: string;
  35.     FErrorIndexName: string;
  36.     FErrorDirName: string;
  37.     FErrorKeyName: string;
  38.     FErrorAlias: string;
  39.     FErrorDriveName: string;
  40.     FErrorNativeCode: string;
  41.     FErrorNativeMsg: string;
  42.     FErrorLineNumber: string;
  43.     FErrorCapability: string;
  44.     procedure OnError(Sender: TObject;E: Exception);
  45.     procedure AssignProps;
  46.   protected
  47.     procedure DoBeforePost; override;
  48.     procedure DoAfterPost; override;
  49.     procedure DoBeforeEdit; override;
  50.     procedure DoAfterEdit; override;
  51.     procedure DoBeforeInsert; override;
  52.     procedure DoAfterInsert; override;
  53.     procedure DoBeforeDelete; override;
  54.     procedure DoAfterDelete; override;
  55.     procedure DoBeforeCancel; override;
  56.     procedure DoAfterCancel; override;
  57.     procedure DoBeforeOpen; override;
  58.     procedure DoAfterOpen; override;
  59.     procedure DoBeforeClose; override;
  60.     procedure DoAfterClose; override;
  61.   public
  62.     { Public declarations }
  63.   published
  64.     property OnKeyViolation: TExceptionEvent read FOnKeyViolation write FOnKeyViolation;
  65.     property OnMinCheckFail: TExceptionEvent read FOnMinCheckFail write FOnMinCheckFail;
  66.     property OnMaxCheckFail: TExceptionEvent read FOnMaxCheckFail write FOnMaxCheckFail;
  67.     property OnFldRequired: TExceptionEvent read FOnFldRequired write FOnFldRequired;
  68.     property OnMasterMissing: TExceptionEvent read FOnMasterMissing write FOnMasterMissing;
  69.     property OnLookupTblFail: TExceptionEvent read FOnLookupTblFail write FOnLookupTblFail;
  70.     property OnRecLockFail: TExceptionEvent read FOnRecLockFail write FOnRecLockFail;
  71.     property OnRecUnLockFail: TExceptionEvent read FOnRecUnlockFail write FOnRecUnlockFail;
  72.     property OnFileIsLocked: TExceptionEvent read FOnFileIsLocked write FOnFileIsLocked;
  73.     property OnDirIsLocked: TExceptionEvent read FOnDirIsLocked write FOnDirIsLocked;
  74.      property OnMultipleNetFiles: TExceptionEvent read FOnMultipleNetFiles write FOnMultipleNetFiles;
  75.     property OnOtherErrors: TExceptionEvent read FOnOtherErrors write FOnOtherErrors;
  76.     property ErrorToken: string read FErrorToken;
  77.     property ErrorTableName: string read FErrorTableName;
  78.     property ErrorFieldName: string read FErrorFieldName;
  79.     property ErrorFieldDispName: string read FErrorFieldDispName;
  80.     property ErrorFieldMinValue: string read FErrorFieldMinValue;
  81.     property ErrorFieldMaxValue: string read FErrorFieldMaxValue;
  82.     property ErrorImageRow: string read FErrorImageRow;
  83.     property ErrorUserName: string read FErrorUserName;
  84.     property ErrorFileName: string read FErrorFileName;
  85.     property ErrorIndexName: string read FErrorIndexName;
  86.     property ErrorDirName: string read FErrorDirName;
  87.     property ErrorKeyName: string read FErrorKeyName;
  88.     property ErrorAlias: string read FErrorAlias;
  89.     property ErrorDriveName: string read FErrorDriveName;
  90.     property ErrorNativeCode: string read FErrorNativeCode;
  91.     property ErrorNativeMsg: string read FErrorNativeMsg;
  92.     property ErrorLineNumber: string read FErrorLineNumber;
  93.     property ErrorCapability: string read FErrorCapability;
  94.   end;
  95.  
  96. procedure Register;
  97.  
  98. implementation
  99.  
  100. procedure Register;
  101. begin
  102.   RegisterComponents('Data Access', [TErrorTable]);
  103. end;
  104.  
  105. procedure TErrorTable.DoBeforePost;
  106. begin
  107.    inherited DoBeforePost;
  108.    FPrevOnException:=Application.OnException;
  109.    Application.OnException:=OnError;
  110. end;
  111.  
  112. procedure TErrorTable.DoAfterPost;
  113. begin
  114.    Application.OnException:=FPrevOnException;
  115.    inherited DoAfterPost;
  116. end;
  117.  
  118. procedure TErrorTable.DoBeforeEdit;
  119. begin
  120.    inherited DoBeforeEdit;
  121.    FPrevOnException:=Application.OnException;
  122.    Application.OnException:=OnError;
  123. end;
  124.  
  125. procedure TErrorTable.DoAfterEdit;
  126. begin
  127.    Application.OnException:=FPrevOnException;
  128.    inherited DoAfterEdit;
  129. end;
  130.  
  131. procedure TErrorTable.DoBeforeInsert;
  132. begin
  133.    inherited DoBeforeInsert;
  134.    FPrevOnException:=Application.OnException;
  135.    Application.OnException:=OnError;
  136. end;
  137.  
  138. procedure TErrorTable.DoAfterInsert;
  139. begin
  140.    Application.OnException:=FPrevOnException;
  141.    inherited DoAfterInsert;
  142. end;
  143.  
  144. procedure TErrorTable.DoBeforeDelete;
  145. begin
  146.    inherited DoBeforeDelete;
  147.    FPrevOnException:=Application.OnException;
  148.    Application.OnException:=OnError;
  149. end;
  150.  
  151. procedure TErrorTable.DoAfterDelete;
  152. begin
  153.    Application.OnException:=FPrevOnException;
  154.    inherited DoAfterDelete;
  155. end;
  156.  
  157. procedure TErrorTable.DoBeforeCancel;
  158. begin
  159.    inherited DoBeforeCancel;
  160.    FPrevOnException:=Application.OnException;
  161.    Application.OnException:=OnError;
  162. end;
  163.  
  164. procedure TErrorTable.DoAfterCancel;
  165. begin
  166.    Application.OnException:=FPrevOnException;
  167.    inherited DoAfterCancel;
  168. end;
  169.  
  170. procedure TErrorTable.DoBeforeOpen;
  171. begin
  172.    inherited DoBeforeOpen;
  173.    FPrevOnException:=Application.OnException;
  174.    Application.OnException:=OnError;
  175. end;
  176.  
  177. procedure TErrorTable.DoAfterOpen;
  178. begin
  179.    Application.OnException:=FPrevOnException;
  180.    inherited DoAfterOpen;
  181. end;
  182.  
  183. procedure TErrorTable.DoBeforeClose;
  184. begin
  185.    inherited DoBeforeClose;
  186.    FPrevOnException:=Application.OnException;
  187.    Application.OnException:=OnError;
  188. end;
  189.  
  190. procedure TErrorTable.DoAfterClose;
  191. begin
  192.    Application.OnException:=FPrevOnException;
  193.    inherited DoAfterClose;
  194. end;
  195.  
  196. procedure TErrorTable.OnError(Sender: TObject;E: Exception);
  197. begin
  198.   if (E is EDatabaseError) then
  199.      begin
  200.         if (E is EDBEngineError) then
  201.            begin
  202.            AssignProps;
  203.            with E as EDBEngineError do
  204.              case Errors[0].ErrorCode of
  205.                 DBIERR_KEYVIOL: if Assigned(FOnKeyViolation) then FOnKeyViolation(Self, E);
  206.                 DBIERR_MINVALERR: if Assigned(FOnMinCheckFail) then FOnMinCheckFail(Self, E);
  207.                 DBIERR_MAXVALERR: if Assigned(FOnMaxCheckFail) then FOnMaxCheckFail(Self, E);
  208.                 DBIERR_REQDERR: if Assigned(FOnFldRequired) then FOnFldRequired(Self, E);
  209.                 DBIERR_FORIEGNKEYERR: if Assigned(FOnMasterMissing) then FOnMasterMissing(Self, E);
  210.                 DBIERR_LOOKUPTABLEERR: if Assigned(FOnLookupTblFail) then FOnLookupTblFail(Self, E);
  211.                 DBIERR_LOCKED: if Assigned(FOnRecLockFail) then FOnRecLockFail(Self, E);
  212.                 DBIERR_UNLOCKFAILED: if Assigned(FOnRecUnLockFail) then FOnRecUnLockFail(Self, E);
  213.                 DBIERR_FILELOCKED: if Assigned(FOnFileIsLocked) then FOnFileIsLocked(Self, E);
  214.                 DBIERR_DIRLOCKED: if Assigned(FOnDirIsLocked) then FOnDirIsLocked(Self, E);
  215.                 DBIERR_NETMULTIPLE: if Assigned(FOnMultipleNetFiles) then FOnMultipleNetFiles(Self, E);
  216.              else
  217.                 if Assigned(FOnOtherErrors) then FOnOtherErrors(Self, E);
  218.              end
  219.            end
  220.         else
  221.            if Assigned(FOnOtherErrors) then FOnOtherErrors(Self, E);
  222.       end
  223.   else
  224.      if Assigned(FOnOtherErrors) then FOnOtherErrors(Self, E);
  225.  
  226. Application.OnException:=FPrevOnException;
  227.  
  228. end;
  229.  
  230. procedure TErrorTable.AssignProps;
  231. var
  232. pContext: PChar;
  233. ErrorCode: DBIResult;
  234. FldCtr: Integer;
  235. FldPos: Integer;
  236. ValChkCtr: Integer;
  237. TblProps: CURProps;
  238. pValChkDesc: pVCHKDesc;
  239. MinInteger: Integer;
  240. MaxInteger: Integer;
  241. MinSmallInt: Smallint;
  242. MaxSmallInt: Smallint;
  243. MinWord: Word;
  244. MaxWord: Word;
  245. MinFloat: Double;
  246. MaxFloat: Double;
  247. MinCurrency: Double;
  248. MaxCurrency: Double;
  249. MinDateTime: TDateTime;
  250. MaxDateTime: TDateTime;
  251. begin
  252.    try
  253.       GetMem(pContext,DBIMAXMSGLEN+1);
  254.       GetMem(pValChkDesc,SizeOf(VCHKDesc));
  255.  
  256.       ErrorCode:=DbiGetErrorContext(ecTOKEN,pContext);
  257.       FErrorToken:=StrPas(pContext);
  258.       ErrorCode:=DbiGetErrorContext(ecTABLENAME,pContext);
  259.       FErrorTableName:=StrPas(pContext);
  260.       ErrorCode:=DbiGetErrorContext(ecFIELDNAME,pContext);
  261.       FErrorFieldName:=StrPas(pContext);
  262.       ErrorCode:=DbiGetErrorContext(ecIMAGEROW,pContext);
  263.       FErrorImageRow:=StrPas(pContext);
  264.       ErrorCode:=DbiGetErrorContext(ecUSERNAME,pContext);
  265.       FErrorUserName:=StrPas(pContext);
  266.       ErrorCode:=DbiGetErrorContext(ecFILENAME,pContext);
  267.       FErrorFileName:=StrPas(pContext);
  268.       ErrorCode:=DbiGetErrorContext(ecINDEXNAME,pContext);
  269.       FErrorIndexName:=StrPas(pContext);
  270.       ErrorCode:=DbiGetErrorContext(ecDIRNAME,pContext);
  271.       FErrorDirName:=StrPas(pContext);
  272.       ErrorCode:=DbiGetErrorContext(ecKEYNAME,pContext);
  273.       FErrorKeyName:=StrPas(pContext);
  274.       ErrorCode:=DbiGetErrorContext(ecALIAS,pContext);
  275.       FErrorAlias:=StrPas(pContext);
  276.       ErrorCode:=DbiGetErrorContext(ecDRIVENAME,pContext);
  277.       FErrorDriveName:=StrPas(pContext);
  278.       ErrorCode:=DbiGetErrorContext(ecNATIVECODE,pContext);
  279.       FErrorNativeCode:=StrPas(pContext);
  280.       ErrorCode:=DbiGetErrorContext(ecNATIVEMSG,pContext);
  281.       FErrorNativeMsg:=StrPas(pContext);
  282.       ErrorCode:=DbiGetErrorContext(ecLINENUMBER,pContext);
  283.       FErrorLineNumber:=StrPas(pContext);
  284.       ErrorCode:=DbiGetErrorContext(ecCAPABILITY,pContext);
  285.       FErrorCapability:=StrPas(pContext);
  286.  
  287.       FldCtr:=0;
  288.       FldPos:=0;
  289.  
  290.         if FErrorFieldName <> '' then
  291.             begin
  292.          for FldCtr:=0 to (FieldCount-1) do
  293.             begin
  294.             if (Fields[FldCtr].FieldName=FErrorFieldName) then
  295.                begin
  296.                FErrorFieldDispName:=Fields[FldCtr].DisplayLabel;
  297.                FldPos:=FldCtr+1;
  298.                Fields[FldCtr].FocusControl;
  299.                Break;
  300.                end
  301.             end
  302.             end;
  303.  
  304.       if FldPos <> 0 then
  305.             begin
  306.           if DbiGetCursorProps(Handle,TblProps)=DBIERR_NONE then
  307.             begin
  308.             for ValChkCtr:=1 to TblProps.iValChecks do
  309.                if DbiGetVchkDesc(Handle,ValChkCtr,pValChkDesc)=DBIERR_NONE then
  310.                   begin
  311.                   if pValChkDesc^.iFldNum=FldPos then
  312.                      begin
  313.                      if Fields[FldPos-1] is TIntegerField then
  314.                         begin
  315.                         Move(pValChkDesc^.aMinVal,MinInteger,SizeOf(LongInt));
  316.                         Move(pValChkDesc^.aMaxVal,MaxInteger,SizeOf(LongInt));
  317.                         FErrorFieldMinValue:=IntToStr(MinInteger);
  318.                         FErrorFieldMaxValue:=IntToStr(MaxInteger);
  319.                         Break;
  320.                         end;
  321.                      if Fields[FldPos-1] is TSmallIntField then
  322.                         begin
  323.                         Move(pValChkDesc^.aMinVal,MinSmallInt,SizeOf(SmallInt));
  324.                         Move(pValChkDesc^.aMaxVal,MaxSmallInt,SizeOf(SmallInt));
  325.                         FErrorFieldMinValue:=IntToStr(MinSmallInt);
  326.                         FErrorFieldMaxValue:=IntToStr(MaxSmallInt);
  327.                         Break;
  328.                         end;
  329.                      if Fields[FldPos-1] is TWordField then
  330.                         begin
  331.                         Move(pValChkDesc^.aMinVal,MinWord,SizeOf(Word));
  332.                         Move(pValChkDesc^.aMaxVal,MaxWord,SizeOf(Word));
  333.                         FErrorFieldMinValue:=IntToStr(MinWord);
  334.                         FErrorFieldMaxValue:=IntToStr(MaxWord);
  335.                         Break;
  336.                         end;
  337.                      if Fields[FldPos-1] is TFloatField then
  338.                         begin
  339.                         Move(pValChkDesc^.aMinVal,MinFloat,SizeOf(Double));
  340.                         Move(pValChkDesc^.aMaxVal,MaxFloat,SizeOf(Double));
  341.                         FErrorFieldMinValue:=FloatToStr(MinFloat);
  342.                         FErrorFieldMaxValue:=FloatToStr(MaxFloat);
  343.                         Break;
  344.                         end;
  345.                      if Fields[FldPos-1] is TCurrencyField then
  346.                         begin
  347.                         Move(pValChkDesc^.aMinVal,MinCurrency,SizeOf(Double));
  348.                         Move(pValChkDesc^.aMaxVal,MaxCurrency,SizeOf(Double));
  349.                         FErrorFieldMinValue:=FloatToStrF(MinCurrency,ffCurrency,15,2);
  350.                         FErrorFieldMaxValue:=FloatToStrF(MaxCurrency,ffCurrency,15,2);
  351.                         Break;
  352.                         end;
  353.                      if Fields[FldPos-1] is TDateTimeField then
  354.                         begin
  355.                         Move(pValChkDesc^.aMinVal,MinDateTime,SizeOf(TDateTime));
  356.                         Move(pValChkDesc^.aMaxVal,MaxDateTime,SizeOf(TDateTime));
  357.                         FErrorFieldMinValue:=DateTimeToStr(MinDateTime);
  358.                         FErrorFieldMaxValue:=DateTimeToStr(MaxDateTime);
  359.                         Break;
  360.                         end;
  361.                      if Fields[FldPos-1] is TDateField then
  362.                         begin
  363.                         Move(pValChkDesc^.aMinVal,MinDateTime,SizeOf(TDateTime));
  364.                         Move(pValChkDesc^.aMaxVal,MaxDateTime,SizeOf(TDateTime));
  365.                         FErrorFieldMinValue:=DateToStr(MinDateTime);
  366.                         FErrorFieldMaxValue:=DateToStr(MaxDateTime);
  367.                         Break;
  368.                         end;
  369.                      if Fields[FldPos-1] is TTimeField then
  370.                         begin
  371.                         Move(pValChkDesc^.aMinVal,MinDateTime,SizeOf(TDateTime));
  372.                         Move(pValChkDesc^.aMaxVal,MaxDateTime,SizeOf(TDateTime));
  373.                         FErrorFieldMinValue:=TimeToStr(MinDateTime);
  374.                         FErrorFieldMaxValue:=TimeToStr(MaxDateTime);
  375.                         Break;
  376.                         end;
  377.                      end
  378.                   end
  379.             end
  380.          else
  381.             begin
  382.             FErrorFieldMinValue:='';
  383.             FErrorFieldMaxValue:='';
  384.             end
  385.          end;
  386.  
  387.    finally
  388.         if pContext <> nil then FreeMem(pContext,DBIMAXMSGLEN+1);
  389.       if pValChkDesc <> nil then FreeMem(pValChkDesc,SizeOf(VCHKDesc));
  390.    end;
  391. end;
  392.  
  393. end.
  394.